(define-class expression object
  (fields (type default: object-type)
	  (type-wired? default: #f)
	  (subexpressions default: '())
	  (uses default: '())
	  (contains-statements? default: #f)
	  (constant? default: #f))
  (methods unparse eval
	   ;; compiler
	   compile compile-infix compile-application compile-statement
	   ;; general structure analysis
	   simplify find-subexpressions statement?
	   hoist-begins
	   ;; type inference
	   propagate-types))

(define-method (find-subexpressions (e expression))
  '())

(define-method (statement? (e expression))
  #f)

;;;;
;;;; TOP-LEVEL FORMS
;;;;

(define-class class-definition expression
  (args name parent interfaces initargs members attributes)
  (fields name parent interfaces members initargs attributes))

(define-method (find-subexpressions (c class-definition))
  (members c))

(define-class member-definition expression
  (args var native-name keywords rtype value)
  (fields var native-name keywords rtype value))

(define-method (find-subexpressions (m member-definition))
  (define v (value m))
  (if v
      (list v)
      '()))

; Deprecated
;(define-class definition expression
;  (args var)
;  (fields var))

;(define-method (find-subexpressions (d definition))
;  (list (initial-value (var d))))

;(define-method (statement? (d definition))
;  #t)

;;;;
;;;; PRIMITIVE EXPRESSIONS
;;;;

;;; CONSTANTS

(define-class constant expression
  (args value)
  (fields value))

(define-method (initialize! (c constant))
  (set (type c) (type-of-constant (value c))))

;;; DIFFERENT TYPES OF VARIABLES

(define (native-variable-name v)
  (define (figure-it-out)
    (define t (type v))
    (define n (name v))

    (let ((native (cond ((eq? t type-type)
			 (native-type-name n))
			((is? t procedure-type)
			 (native-method-name n))
			(else
			 (native-field-name n)))))
      (set (native-name v) native)
      native))

  (or (native-name v)
      (figure-it-out)))

(define-class variable expression
  (args name initial-value type)
  (fields name native-name
	  (initial-value type: expression)))

(define-class global-variable variable
  (fields (defined? default: #f)
	  current-value
	  (keywords default: '()) )
  (args name initial-value))

(define-class local-variable variable
  (args name offset snl initial-value type type-wired?)
  (fields offset snl uses modified? escapes?))

;;;;
;;;; COMPOUND EXPRESSIONS
;;;;

;;; APPLICATIONS

(define-class application expression
  (args operator arguments)
  (fields operator arguments))

(define-method (find-subexpressions (a application))
  (cons (operator a) (arguments a)))

(define-method (statement? (a application))
  (eq? (operator a)
       throw-var))

;;; SPECIAL FORMS

(define-class return expression
  (args exp)
  (fields exp))

(define-method (find-subexpressions (r return))
  (list (exp r)))

(define-method (statement? (r return))
  #t)

(define-class conditional expression
  (args test consequent alternative)
  (fields test consequent alternative))

(define-method (find-subexpressions (c conditional))
  (define alt (alternative c))
  (if (null? alt)
      (list (test c) (consequent c))
      (list (test c)
	    (consequent c)
	    (alternative c))))

(define-class set-expression expression
  (args lvalue rvalue)
  (fields lvalue rvalue))

(define-method (find-subexpressions (s set-expression))
  (list (lvalue s) (rvalue s)))

(define-class begin-expression expression
  (args body)
  (fields body))

(define-method (statement? (e begin-expression))
  #t)

(define-method (find-subexpressions (b begin-expression))
  (body b))
(define-class the-expression expression
  (args declared-type exp)
  (fields declared-type exp))

(define-method (initialize! (t the-expression))
  (when (is? (declared-type t)
	     expression)
    (set (declared-type t)
	 (type-expression-value (declared-type t))))
  (set (type t)
       (type-glb (declared-type t)
		 (type (exp t)))))

(define-method (find-subexpressions (t the-expression))
  (list (exp t)))

(define-class cast-expression the-expression
  (args declared-type exp))

(define-method (initialize! (t cast-expression))
  (when (is? (declared-type t)
	     expression)
    (set (declared-type t)
	 (type-expression-value (declared-type t))))
  (set (type t) (declared-type t)))

(define-class lambda-expression begin-expression
  (args variables body snl)
  (fields variables snl))

(define-method (initialize! (l lambda-expression))
  (set (type l)
       (new-procedure-type simple-procedure-type
			   object-type
			   (map (lambda (x)
				  object-type)
				(variables l)))))

(define-class let-expression lambda-expression
  (args variables body snl))

(define-method (initialize! (l let-expression))
  ;; just to defeat the lambda initializer
  #f)

(define-method (find-subexpressions (l let-expression))
  (append (map initial-value (variables l))
	  (body l)))

(define-class while-expression begin-expression
  (args test body)
  (fields test))

(define-method (find-subexpressions (w while-expression))
  (cons (test w) (body w)))

(define-class for-expression let-expression
  (args variables test iterators body snl)
  (fields test iterators))

(define-method (find-subexpressions (l for-expression))
  (cons (test l)
	(append (iterators l)
		(map initial-value (variables l))
		(body l))))